Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / bastodos.bas (.txt) < prev next >

Wrap

GW-BASIC | 1984-04-24 | 45.5 KB | 1,545 lines

10 '* 15 '************************************************************************* 20 '* 25 '* BASIC WORKSHOP SERIES 30 '* 35 '* NUMBER 1 40 '* 45 '* BY 50 '* 55 '* JAMES P. MORGAN 60 '* 1749 AMERICANA BLVD APT 23-G 65 '* ORLANDO FLA, 32809 70 '* 75 '* WORK PH:(305) 826-7297 80 '* 85 '* I HAVE PUT TOGETHER, FOR YOU, A SET OF CALLABLE ASSEMBLER SUBROUTINES 90 '* FROM BASIC, TO ALLOW YOU MORE CONTROL OVER YOUR SYSTEM. THESE ROUTINES 95 '* ENABLE YOU TO ACCESS DOS FUNCTIONS NOT SUPPORTED BY THE INTERPRETER OR 100 '* THE BASIC COMPILER, FOR MOST OF THE NEW EXTENDED DOS 2.0 FUNCTIONS. 105 '* 110 '* I HAVE DEBUGGED THE ROUTINES AS MUCH AS MY LIMITED TIME WOULD PERMIT. 115 '* PLEASE EXCUSE THE TYPING ERROR, I COME FROM THE HUNT AND PEEK SCHOOL 120 '* OF TYPING. ALSO I SCRATCHED MY MASTER FILE AND HAD TO REKEY ALL OF THIS. 125 '* THE LESSON LEARNED , ALWAYS KEEP A BACK UP OF LARGE FILES, EVEN IF 130 '* NOT A TOTAL CURRENT ONE. 135 '* 140 '* A NOTE OF WARNING, THESE SUBROUTINES DO LITTLE OR NO VALIDITY CHECKING 145 '* AS TO THE FORMAT, TYPE AND RANGE OF VARIABLES PASSED, SO BE WARNED IF 150 '* YOU DO NOT FOLLOW THE RULES AND YOUR MACHINE LOCKS UP TIGHT. 155 '* 160 '* THERE ARE MORE SUBROUTINES FORTHCOMING, SO LOOK FOR THEM, SUCH AS 165 '* GETTING/SETTING THE INTERRUPT VECTORS, PARSEING A FILENAME, PASSING 170 '* RETURN CODES FROM A PROGRAM TO BATCH JOBS, AND MORE. 175 '* 180 '* DOS 2.0 DEFINITIONS 185 '* ----------------------- 190 '* 195 '* ASCIIZ STRING - NORMAL TEXT STRING, USUALLY CONSISTING OF A DRIVE, 200 '* PATH , AND/OR FILENAME (EXP:"A:\COBOL\COBPGM.COB") 205 '* TERMINATED BY A HEX 00/(CHR$(0)). 210 '* 215 '* THERE ARE MORE RETURN CODES OUTPUT BY THE NEW DOS 2.0 FUNCTION CALLS. 220 '* 225 '* 1 - INVALID FUNCTION NUMBER 230 '* 2 - FILE NOT FOUND 235 '* 3 - PATH NOT FOUND 240 '* 4 - TOO MANY OPEN FILES 245 '* 5 - ACCESS DENIED 250 '* 6 - INVALID HANDLE 255 '* 7 - MEMORY CONTROL BLOCKS DESTROYED 260 '* 8 - INSUFFICIENT MEMORY 265 '* 9 - INVALID MEMORY BLOCK ADDRESS 270 '* 10 - INVALID ENVIRONMENT 275 '* 11 - INVALID FORMAT 280 '* 12 - INVALID ACCESS CODE 285 '* 15 - INVALID DRIVE WAS SPECIFIED 290 '* 16 - ATTEMPTED TO REMOVE THE CURRENT DIRECTORY 295 '* 17 - NOT SAME DEVICE 300 '* 18 - MO MORE FILES 305 '* 310 '* SOME SUBROUTINES STILL DO CALLS TO THE DOS 1.1 FUNCTION CALLS 315 '* AND THEY RETURN THEIR OWN PARTICULAR RESULT CODES. 320 '* 325 '* AS ALWAYS, IF IN DOUBT, CONSULT THE TECHNICAL GUIDE AND THE TECHNICAL 330 '* SECTION OF THE DOS MANUAL AS TO THE FORMAT AND OBJECTIVE OF ANY OF THE 335 '* FUNCTION CALLS. 340 '* 345 '* NOTE: 350 '* THE PROGRAMS WILL CREATE A .COM TYPE FILE, IF YOU TEST RUN EACH 360 '* ONE SEPARATELY. THESE .COM TYPE FILES MAY THEN BE READ BY OTHER 370 '* PROGRAMS AND POKED INTO A VARIABLE ARRAY IN THE NEW PROGRAM, AS WAS 380 '* DONE IN THE TEST PROGRAMS. 390 '* BOTH THE INTERPERTER AND BASIC COMPILER ARE SUPPORTED IN THE DATA 400 '* STATEMENTS IN THE PROGRAMS. YOU MUST, I REPEAT, YOU MUST COMMENT OUT 405 '* THE DATA STATEMENTS FLAGGED THAT DO NOT APPLY TO THE MODE YOU ARE 410 '* RUNNING IN. YOU CANNOT RUN THE BASIC COMPILER DATA STATEMENTS WHILE 415 '* RUNNING THE INTERPERTER. YOU MAY HOWEVER CREATE THE .COM TYPE FILES 420 '* FOR USE BY COMPILED PROGRAMS. BY CHANGING THE DATA STATEMENTS AS 425 '* ADVISED AND PUTTING AN "END' STATEMENT JUST AFTER THE 'GOSUB' THAT 430 '* CREATES THE DISK .COM FILE. 435 '* 440 '* 'KEEP ON COMPUTING AND SHARING' 500 '********************************************************************** 501 '* 502 '* SUBROUTINE FUNCTION : CNTL-BREAK CHECK 503 '* 504 '* VERSION : 1.0 505 '* 506 '* DATE LAST UPDATED : SEPT 25, 1983 507 '* 508 '* AUTHOR : JAMES P MORGAN 509 '* 510 '* CALL FORMAT : 511 '* --------------------- 512 '* CALL OFFSET%(CNTL.BREAK.STATE%,RETURN.CODE%) 513 '* 514 '* PARAMETERS PASSED : CNTL.BREAK.STATE% (00=REQUEST CURRENT STATE 515 '* 01=FLIP/FLOP CURRENT STATE 516 '* 517 '* RETURN.CODE%=0 518 '* 519 '* PARAMETERS RETURNED : CNTL.CREAK.STATE% 520 '* 521 '* RETURN.CODE% (00=CNTL-BREAK ON 522 '* 01=CNTL-BREAK OFF) 523 '* 524 '* COMMENTS : 525 '* 526 '* THIS SUBROUTINE WILL FLIP/FLOP THE CNTL-BREAK 527 '* SWITCH FROM ON/OFF OR OFF/ON AND RETURN THE CURRENT 528 '* STATE OR JUST RETURN THE CURRENT STATE OF THE 529 '* CNTL-BREAK SWITCH. 530 '* 531 '************************************************************************** 537 CLS 538 CLOSE 539 DEF SEG 540 DEFINT A-Z 541 DIM SUBRT%(40) 542 OFFSET%=0 543 CNTL.BREAK.STATE%=0 544 CURRENT.STATE%=0 545 RETURN.CODE%=0 546 GOSUB 576 547 GOSUB 555 548 OFFSET%=VARPTR(SUBRT%(0)) 549 CALL OFFSET%(CNTL.BREAK.STATE%,RETURN.CODE%) 550 CURRENT.STATE%=RETURN.CODE% 551 PRINT "CNTL BREAK REQUEST= ";CNTL.BREAK.STATE% 552 PRINT "CURRENT STATE = ";CURRENT.STATE% 553 PRINT "RETURN CODE = ";RETURN.CODE% 554 END 555 FOR I=0 TO 31 556 READ J 557 POKE (VARPTR(SUBRT%(0))+I),J 558 NEXT 559 RETURN 560 DATA &H55 561 DATA &H89,&HE5 562 DATA &HB0,&H00 563 DATA &HB2,&H00 564 DATA &HB4,&H33 565 DATA &HCD,&H21 566 DATA &H8B,&H76,&H08 567 DATA &H8A,&H04 568 DATA &H80,&HF2,&H01 569 DATA &HB4,&H33 570 DATA &HCD,&H21 571 DATA &H8B,&H76,&H06 572 DATA &H88,&H14 573 DATA &H5D 574 DATA &HCA,&H04,&H00 575 END 576 RESTORE 577 FILENAME$="A:"+"CNTLBRK.EMU" 578 PGM.LEN=31 579 OPEN FILENAME$ AS #1 LEN=1 580 FIELD #1, 1 AS PGM.BYTE$ 581 FOR I=0 TO PGM.LEN 582 READ J 583 LSET PGM.BYTE$=CHR$(J) 584 PUT #1 585 NEXT 586 CLOSE 587 RESTORE 588 RETURN 1000 '********************************************************************** 1001 '* 1002 '* SUBROUTINE FUNCTION : GET DRIVE TYPE 1003 '* 1004 '* VERSION : 1.0 1005 '* 1006 '* DATE LAST UPDATED : SEPT 25, 1983 1007 '* 1008 '* AUTHOR : JAMES P MORGAN 1009 '* 1010 '* CALL FORMAT : 1011 '* --------------------- 1012 '* CALL OFFSET%(DRIVE%,RETURN.CODE%) 1013 '* 1014 '* PARAMETERS PASSED : DRIVE% (00=DEFAULT,1=A,2=B..ECT) 1015 '* 1016 '* RETURN.CODE%=0 1017 '* 1018 '* PARAMETERS RETURNED : DRIVE% 1019 '* 1020 '* RETURN.CODE% (255=INVALID DRIVE) 1021 '* 1022 '* COMMENTS : 1023 '* 1024 '* THIS ROUTINE RETURNS THE DRIVE TYPE. THE DOS 1025 '* FUNCTION CALL '1CH' ID USED. THIS DOS FUNCTION CALL 1026 '* DOES NOT FUNCTION UNDER 2.0 AS IT DID UNDER 1.1. 1027 '* UNDER 1.1 THE FATS (FILE ALLOCATION TABLES) WERE 1028 '* MAINTAINED IN MEMORY AND THIS CALL WOULD POINT YOU 1029 '* TO THE FAT IN MEMORY. 1030 '* UNDER 2.0 THIS CALL NOW ONLY POINTS YOU TO THE 1031 '* DRIVE TYPE CODE IN MEMORY. 1032 '************************************************************************** 1033 CLS 1034 CLOSE 1035 DEF SEG 1036 DEFINT A-Z 1037 DIM SUBRT%(40) 1038 OFFSET%=0 1039 DRIVE%=0 1040 DUAL.8.SECTORS=255 'FF 1041 SINGLE.8.SECTORS=254 'FE 1042 DUAL.9.SECTORS=253 'FD 1043 SINGLE.9.SECTORS=252 'FC 1044 FIXED.DISK=248 'F8 1045 RETURN.CODE%=0 1046 GOSUB 1086 1047 GOSUB 1062 1048 REQUESTED.DRIVE%=DRIVE% 1049 OFFSET%=VARPTR(SUBRT%(0)) 1050 CALL OFFSET%(DRIVE%,RETURN.CODE%) 1051 PRINT "DRIVE REQUESTED = ";REQUESTED.DRIVE% 1052 PRINT "DRIVE TYPE CODE = ";DRIVE% 1053 IF RETURN.CODE%=255 THEN DRIVE.TYPE$="INVALID DRIVE SPECIFIED":GOTO 1059 1054 IF DRIVE%=255 THEN DRIVE.TYPE$="DUAL.SIDED, 8 SECTORS PER TRACK" 1055 IF DRIVE%=254 THEN DRIVE.TYPE$="SINGLE SIDED, 8 SECTORS PER TRACK" 1056 IF DRIVE%=253 THEN DRIVE.TYPE$="DUAL SIDED, 9 SECTORS PER TRACK" 1057 IF DRIVE%=252 THEN DRIVE.TYPE$="SINGLE SIDED, 9 SECTORS PER TRACK" 1058 IF DRIVE%=248 THEN DRIVE.TYPE$="FIXED DISK" 1059 PRINT "DRIVE TYPE = ";DRIVE.TYPE$ 1060 PRINT "RETURN CODE = ";RETURN.CODE% 1061 END 1062 FOR I=0 TO 37 1063 READ J 1064 POKE (VARPTR(SUBRT%(0))+I),J 1065 NEXT 1066 RETURN 1067 DATA &H55 1068 DATA &H89,&HE5 1069 DATA &H31,&HC0 1070 DATA &H31,&HDB 1071 DATA &H31,&HC9 1072 DATA &H31,&HD2 1073 DATA &H8B,&H76,&H08 1074 DATA &H8A,&H14 1075 DATA &HB4,&H1C 1076 DATA &H1E 1077 DATA &HCD,&H21 1078 DATA &H8A,&H27 1079 DATA &H1F 1080 DATA &H8B,&H76,&H08 1081 DATA &H88,&H24 1082 DATA &H8B,&H76,&H06 1083 DATA &H88,&H04 1084 DATA &H5D 1085 DATA &HCA,&H04,&H00 1086 RESTORE 1087 FILENAME$="A:"+"DRIVETYP.EMU" 1088 PGM.LEN=37 1089 OPEN FILENAME$ AS #1 LEN=1 1090 FIELD #1, 1 AS PGM.BYTE$ 1091 FOR I=0 TO PGM.LEN 1092 PGM.LEN=37 1093 PUT #1 1094 NEXT 1095 CLOSE 1096 RESTORE 1097 RETURN 1500 '********************************************************************** 1501 '* 1502 '* SUBROUTINE FUNCTION : GET FIRST/NEXT MATCHING FILE 1503 '* 1504 '* VERSION : 1.0 1505 '* 1506 '* DATE LAST UPDATED : SEPT 25, 1983 1507 '* 1508 '* AUTHOR : JAMES P MORGAN 1509 '* 1510 '* CALL FORMAT : 1511 '* --------------------- 1512 '* CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,DTA%(0),RETURN.CODE%) 1513 '* 1514 '* PARAMETERS PASSED : FUNCTION.CODE% (&H4E=FIND FIRST MATCHING FILE 1515 '* &H4F=FIND NEXT MATCHING FILE) 1516 '* 1517 '* ATTRIBUTE% (ATTRIBUTE TO BE USED IN 1518 '* SEARCHING FOR THE FILE) 1519 '* 1520 '* ASCIIZ.STRING$ (DRIVE,PATH, AND FILENAME) 1521 '* 1522 '* DTA%(0) (PSEUDO DTA TO HOLD MATCHING 1523 '* FILE INFORMATION) 1524 '* 1525 '* RETURN.CODE%=0 1526 '* 1527 '* PARAMETERS RETURNED : FUNCTION.CODE% 1528 '* 1529 '* ATTRIBUTE% 1530 '* 1531 '* ASCIIZ.STRING$ 1532 '* 1533 '* DTA%(0) (FILLED WITH MATCHING DTA INFO) 1534 '* 1535 '* RETURN.CODE% 1536 '* 1537 '* COMMENTS : 1538 '* 1539 '* THIS SUBROUTINE SEARCHS A DIRECTORY FOR A 1540 '* FILE WITH MATCHING FILE ATTRIBUTE AND CHARACTERS. 1541 '* THE ASCIIZ STRING CONSISTS OF A DRIVE , PATH , 1542 '* AND FILENAME. GLOBAL FILENAME CHARACTERS ARE ALLOWED 1543 '* IN THE FILENAME PORTION OF THE STRING. 1544 '* IF A FILE IS FOUND THAT MATCHES THE SPECIFIED 1545 '* DRIVE, PATH, AND FILENAME AND ATTRIBUTE, THE DTA 1546 '* IS FILLED IN AS FOLLOWS: 1547 '* 1548 '* 21 BYTES - RESERVED FOR DOS USE ON SUBSEQUENT 1549 '* FIND NEXT CALLS 1550 '* 1551 '* 2 BYTES - FILES CREATE/UPDATE TIME 1552 '* 1553 '* 2 BYTES - FILES CREATE/UPDATE DATE 1554 '* 1555 '* 2 BYTES - LOW WORD OF FILE SIZE 1556 '* 1557 '* 2 BYTES - HIGH WORD OF FILE SIZE 1558 '* 1559 '* 13 BYTES - NAME AND EXTENTION OF FILE FOUND 1560 '* FOLLOWED BY A BYTE OF HEX 00. 1561 '* 1562 '* ALL BLANKS ARE REMOVED FROM THE NAME 1563 '* AND EXTENTION, AND IF AN EXTENTION IS 1564 '* PRESENT, IT IS PRECEEDED BY A PERIOD. 1565 '* THE NAME WOULD BE RETURNED JUST AS YOU 1566 '* HAD ENTERED IT AS A COMMAND PARAMETER, 1567 '* SUCH AS 'TREE.COM'. 1568 '* IF YOU ASK FOR ALL FILES IN A SUB-DIREC- 1569 '* TORY, THIS ROUTINE WILL RETURN THE '.' 1570 '* THE '..' THAT YOU SEE WHEN YOU DO A 'DIR' 1571 '* ON A SUB-DIRECTORY. 1572 '* YOU CAN USE THE GET FIRST OPTION TO 1573 '* RETURN THE VOLUMN LABEL, SINCE IT IS 1574 '* BASICALLY AN EMPTY FILE WITH A SPECIAL 1575 '* ATTRIBUTE IN THE DIRECTORY. 1576 '* 1577 '************************************************************************** 1578 CLS 1579 CLOSE 1580 DEF SEG 1581 DEFINT A-Z 1582 DIM SUBRT%(40) 1583 OFFSET%=0 1584 DIM DTA%(40) 1585 FOR I=0 TO 40:DTA%(I)=-1:NEXT 1586 FUNCTION.CODE%=&H4E 1587 PATH$="A:*.*" 1588 ASCIIZ.STRING$=PATH$+CHR$(0) 1589 ATTRIBUTE%=255 1590 RETURN.CODE%=0 1591 GOSUB 1652 1592 GOSUB 1608 1593 GOSUB 1598 1594 FUNCTION.CODE%=&H4F 1595 GOSUB 1598 1596 IF RETURN.CODE%=0 GOTO 1595 1597 END 1598 OFFSET%=VARPTR(SUBRT%(0)) 1599 CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,DTA%(0),RETURN.CODE%) 1600 PRINT "RETURN CODE = ";RETURN.CODE% 1601 IF RETURN.CODE%=18 THEN PRINT :RETURN 1602 FOR I=30 TO 43 1603 PRINT CHR$(PEEK(VARPTR(DTA%(0))+I)); 1604 NEXT 1605 PRINT 1606 RETURN 1607 END 1608 FOR I=0 TO 65 1609 READ J 1610 POKE (VARPTR(SUBRT%(0))+I),J 1611 NEXT 1612 RETURN 1613 DATA &H55 1614 DATA &H89,&HE5 1615 DATA &H31,&HC0 1616 DATA &H31,&HC9 1617 DATA &H31,&HD2 1618 DATA &H8B,&H76,&H0E 1619 DATA &H8A,&H24 1620 DATA &H8B,&H76,&H0C 1621 DATA &H8B,&H0C 1622 DATA &H8B,&H76,&H0A 1623 '********COMMENT OUT THE NEXT DATA STATEMENT IF USED WITH THE BASIC COMPILER 1624 DATA &H8B,&H54,&H01 1625 '********COMMENT OUT THE NEXT DATA STATEMENT IF USED WITH THE BASIC INTERPRETER 1626 'DATA &H8B,&H54,&H02 1627 DATA &HCD,&H21 1628 DATA &H8B,&H76,&H06 1629 DATA &H88,&H04 1630 DATA &H8B,&H76,&H08 1631 DATA &H89,&HF7 1632 DATA &H06 1633 DATA &H31,&HDB 1634 DATA &HB4,&H2F 1635 DATA &HCD,&H21 1636 DATA &HFC 1637 DATA &HB9,&H2C,&H00 1638 DATA &H89,&HDE 1639 DATA &H90,&H90,&H90 1640 DATA &H1E 1641 DATA &H06 1642 DATA &H1F 1643 DATA &H07 1644 DATA &HF3 1645 DATA &HA4 1646 DATA &H06 1647 DATA &H1F 1648 DATA &H07 1649 DATA &H5D 1650 DATA &HCA,&H0A,&H00 1651 END 1652 RESTORE 1653 FILENAME$="A:"+"FRSTNEXT.EMU" 1654 PGM.LEN=65 1655 OPEN FILENAME$ AS #1 LEN=1 1656 FIELD #1,1 AS PGM.BYTE$ 1657 FOR I=0 TO PGM.LEN 1658 READ J 1659 LSET PGM.BYTE$=CHR$(J) 1660 PUT #1 1661 NEXT 1662 CLOSE 1663 RESTORE 1664 RETURN 2000 '********************************************************************** 2001 '* 2002 '* SUBROUTINE FUNCTION : GET VERIFY STATE 2003 '* 2004 '* VERSION : 1.0 2005 '* 2006 '* DATE LAST UPDATED : SEPT 25, 1983 2007 '* 2008 '* AUTHOR : JAMES P MORGAN 2009 '* 2010 '* CALL FORMAT : 2011 '* --------------------- 2012 '* CALL OFFSET%(RETURN.CODE%) 2013 '* 2014 '* PARAMETERS PASSED : RETURN.CODE%=0 2015 '* 2016 '* PARAMETERS RETURNED : RETURN.CODE% (00=VERIFY OFF,01=VERIFY ON) 2017 '* 2018 '************************************************************************** 2019 CLS 2020 CLOSE 2021 DEF SEG 2022 DEFINT A-Z 2023 DIM SUBRT%(40) 2024 OFFSET%=0 2025 VERIFY.STATE%=0 2026 RETURN.CODE%=0 2027 GOSUB 2051 2028 GOSUB 2035 2029 OFFSET%=VARPTR(SUBRT%(0)) 2030 CALL OFFSET%(RETURN.CODE%) 2031 VERIFY.STATE%=RETURN.CODE% 2032 PRINT "VERIFY STATE = ";VERIFY.STATE% 2033 PRINT "RETURN CODE = ";RETURN.CODE% 2034 END 2035 RESTORE 2036 FOR I=0 TO 17 2037 READ J 2038 POKE (VARPTR(SUBRT%(0))+I),J 2039 NEXT 2040 RETURN 2041 DATA &H55 2042 DATA &H89,&HE5 2043 DATA &H30,&HC0 2044 DATA &HB4,&H54 2045 DATA &HCD,&H21 2046 DATA &H8B,&H76,&H06 2047 DATA &H88,&H04 2048 DATA &H5D 2049 DATA &HCA,&H02,&H00 2050 END 2051 RESTORE 2052 FILENAME$="A:"+"VERSTATE.EMU" 2053 PGM.LEN=17 2054 OPEN FILENAME$ AS #1 LEN=1 2055 FIELD #1, 1 AS PGM.BYTE$ 2056 FOR I=0 TO PGM.LEN 2057 READ J 2058 LSET PGM.BYTE$=CHR$(J) 2059 PUT #1 2060 NEXT 2061 CLOSE 2062 RESTORE 2063 RETURN 2500 '********************************************************************** 2501 '* 2502 '* SUBROUTINE FUNCTION : SET/RESET VERIFY SWITCH 2503 '* 2504 '* VERSION : 1.0 2505 '* 2506 '* DATE LAST UPDATED : SEPT 25, 1983 2507 '* 2508 '* AUTHOR : JAMES P MORGAN 2509 '* 2510 '* CALL FORMAT : 2511 '* --------------------- 2512 '* CALL OFFSET%(RETURN.CODE%) 2513 '* 2514 '* PARAMETERS PASSED : RETURN.CODE%=0 2515 '* 2516 '* PARAMETERS RETURNED : RETURN.CODE% (00=VERIFY OFF,01=VERIFY ON) 2517 '* 2518 '* COMMENTS : 2519 '* THIS ROUTINE WILL FLIP/FLOP THE VERIFY STATE 2520 '* SWITCH FROM ON/OFF OR OFF/ON AND RETURN THE CURRENT 2521 '* STATE. 2522 '* WHEN ON,DOS WILL PERFORM A VERIFY OPERATION EACH 2523 '* TIME IT PERFORMS A DISKETTE WRITE TO ASSURE PROPER 2524 '* DATA RECORDING. ALTHOUGH RECORDING ERRORS ARE VERY 2525 '* RARE, THIS FUNCTION IS PROVIDED FOR THOSE USER 2526 '* APPLICATIONS IN WHICH YOU MAY WISH TO VERIFY THE 2527 '* PROPER RECORDING OF CRITICAL DATA. 2528 '************************************************************************** 2529 CLS 2530 CLOSE 2531 DEF SEG 2532 DEFINT A-Z 2533 DIM SUBRT%(40) 2534 OFFSET%=0 2535 VERIFY.STATE%=0 2536 RETURN.CODE%=0 2537 GOSUB 2566 2538 GOSUB 2545 2539 OFFSET%=VARPTR(SUBRT%(0)) 2540 CALL OFFSET%(RETURN.CODE%) 2541 VERIFY.STATE%=RETURN.CODE% 2542 PRINT "VERIFY STATE = ";VERIFY.STATE% 2543 PRINT "RETURN CODE = ";RETURN.CODE% 2544 END 2545 RESTORE 2546 FOR I=0 TO 27 2547 READ J 2548 POKE (VARPTR(SUBRT%(0))+I),J 2549 NEXT 2550 RETURN 2551 DATA &H55 2552 DATA &H89,&HE5 2553 DATA &HB4,&H54 2554 DATA &HCD,&H21 2555 DATA &H34,&H01 2556 DATA &HB2,&H00 2557 DATA &HB4,&H2E 2558 DATA &HCD,&H21 2559 DATA &HB4,&H54 2560 DATA &HCD,&H21 2561 DATA &H8B,&H76,&H06 2562 DATA &H88,&H04 2563 DATA &H5D 2564 DATA &HCA,&H02,&H00 2565 END 2566 RESTORE 2567 FILENAME$="A:"+"VERRESET.EMU" 2568 PGM.LEN=17 2569 OPEN FILENAME$ AS #1 LEN=1 2570 FIELD #1, 1 AS PGM.BYTE$ 2571 FOR I=0 TO PGM.LEN 2572 READ J 2573 LSET PGM.BYTE$=CHR$(J) 2574 PUT #1 2575 NEXT 2576 CLOSE 2577 RESTORE 2578 RETURN 3000 '********************************************************************** 3001 '* 3002 '* SUBROUTINE FUNCTION : GET SYSTEM TIME 3003 '* 3004 '* VERSION : 1.0 3005 '* 3006 '* DATE LAST UPDATED : SEPT 25, 1983 3007 '* 3008 '* AUTHOR : JAMES P MORGAN 3009 '* 3010 '* CALL FORMAT : 3011 '* --------------------- 3012 '* CALL OFFSET%(HOURS%,MINUTES%,SECONDS%,HUNDREDS.SECONDS%,RETURN.CODE%) 3013 '* 3014 '* PARAMETERS PASSED : HOURS%=0 3015 '* MINUTES%=0 3016 '* SECONDS%-0 3017 '* HUNDREDS.SECONDS%=0 3018 '* RETURN.CODE%=0 3019 '* 3020 '* PARAMETERS RETURNED : HOURS% (0-23) 3021 '* MINUTES% (0-59) 3022 '* SECONDS% (0-59) 3023 '* HUNDREDS.SECONDS% (0-99) 3024 '* RETURN.CODE% 3025 '* 3026 '* COMMENTS : 3027 '* THIS FORMAT IS READILY CONVERTED TO A PRINTABLE 3028 '* FORM YET CAN BE USED FOR CALCULATIONS , SUCH AS 3029 '* SUBTRACTING ONE TIME VALUE FROM ANOTHER. 3030 '* 3031 '************************************************************************** 3032 CLS 3033 CLOSE 3034 DEF SEG 3035 DEFINT A-Z 3036 DIM SUBRT%(40) 3037 OFFSET%=0 3038 HOURS%=0 3039 MINUTES%=0 3040 SECONDS%=0 3041 HUNDREDS.SECONDS%=0 3042 RETURN.CODE%=0 3043 GOSUB 3080 3044 GOSUB 3054 3045 OFFSET%=VARPTR(SUBRT%(0)) 3046 CALL OFFSET%(HOURS%,MINUTES%,SECONDS%,HUNDREDS.SECONDS%,RETURN.CODE%) 3047 PRINT "HOURS = ";HOURS% 3048 PRINT "MINUTES = ";MINUTES% 3049 PRINT "SECONDS = ";SECONDS% 3050 PRINT "1/100 SECONDS = ";HUNDREDS.SECONDS% 3051 PRINT "RETURN CODE = ";RETURN.CODE% 3052 PRINT "CURRENT TIME = ";TIME$ 3053 END 3054 RESTORE 3055 FOR I=0 TO 41 3056 READ J 3057 POKE (VARPTR(SUBRT%(0))+I),J 3058 NEXT 3059 RETURN 3060 DATA &H55 3061 DATA &H89,&HE5 3062 DATA &H31,&HC9 3063 DATA &H31,&HD2 3064 DATA &HB4,&H2C 3065 DATA &HCD,&H21 3066 DATA &H8B,&H76,&H0E 3067 DATA &H88,&H2C 3068 DATA &H8B,&H76,&H0C 3069 DATA &H88,&H0C 3070 DATA &H8B,&H76,&H0A 3071 DATA &H88,&H34 3072 DATA &H8B,&H76,&H08 3073 DATA &H88,&H14 3074 DATA &H30,&HD2 3075 DATA &H8B,&H76,&H06 3076 DATA &H88,&H14 3077 DATA &H5D 3078 DATA &HCA,&H0A,&H00 3079 END 3080 RESTORE 3081 FILENAME$="A:"+"GETTIME.EMU" 3082 PGM.LEN=41 3083 OPEN FILENAME$ AS #1 LEN=1 3084 FIELD #1, 1 AS PGM.BYTE$ 3085 FOR I=0 TO PGM.LEN 3086 READ J 3087 LSET PGM.BYTE$=CHR$(J) 3088 PUT #1 3089 NEXT 3090 CLOSE 3091 RESTORE 3092 RETURN 3500 '********************************************************************** 3501 '* 3502 '* SUBROUTINE FUNCTION : GET SYSTEM DATE 3503 '* 3504 '* VERSION : 1.0 3505 '* 3506 '* DATE LAST UPDATED : SEPT 25, 1983 3507 '* 3508 '* AUTHOR : JAMES P MORGAN 3509 '* 3510 '* CALL FORMAT : 3511 '* --------------------- 3512 '* CALL OFFSET%(CENTURY%,YEAR%,MONTH%,DAY%,RETURN.CODE%) 3513 '* 3514 '* PARAMETERS PASSED : CENTURY%=0 3515 '* YEAR%=0 3516 '* MONTH%=0 3517 '* DAY%=0 3518 '* RETURN.CODE%=0 3519 '* 3520 '* PARAMETERS RETURNED : CENTURY% 3521 '* YEAR% 3522 '* MONTH% 3523 '* DAY% 3524 '* RETUURN.CODE% 3525 '* 3526 '* COMMENTS : 3527 '* IF THE TIME-OF-DAY CLOCK ROLLS OVER TO THE NEXT 3528 '* DAY, THE DATA IS ADJUSTED ACCORDINGLY, TAKING 3529 '* INTO ACCOUNT THE NUMBER OF DAYS IN EACH MONTH AND 3530 '* LEAP YEARS. 3531 '************************************************************************** 3532 CLS 3533 CLOSE 3534 DEF SEG 3535 DEFINT A-Z 3536 DIM SUBRT%(40) 3537 OFFSET%=0 3538 CENTURY%=0 3539 YEAR%=0 3540 MONTH%=0 3541 DAY%=0 3542 RETURN.CODE%=0 3543 GOSUB 3581 3544 GOSUB 3555 3545 OFFSET%=VARPTR(SUBRT%(0)) 3546 CALL OFFSET%(CENTURY%,YEAR%,MONTH%,DAY%,RETURN.CODE%) 3547 PRINT "CENTURY = ";CENTURY% 3548 PRINT "YEAR = ";YEAR% 3549 PRINT "CENTURY + YEAR = ";CENTURY%+YEAR% 3550 PRINT "MONTH = ";MONTH% 3551 PRINT "DAY = ";DAY% 3552 PRINT "RETURN CODE = ";RETURN.CODE% 3553 PRINT "CURRENT DATE = ";DATE$ 3554 END 3555 RESTORE 3556 FOR I=0 TO 42 3557 READ J 3558 POKE (VARPTR(SUBRT%(0))+I),J 3559 NEXT 3560 RETURN 3561 DATA &H55 3562 DATA &H89,&HE5 3563 DATA &H31,&HC9 3564 DATA &H31,&HD2 3565 DATA &HB4,&H2A 3566 DATA &HCD,&H21 3567 DATA &H8B,&H76,&H0E 3568 DATA &H88,&H6C,&H01 3569 DATA &H8B,&H76,&H0C 3570 DATA &H88,&H0C 3571 DATA &H8B,&H76,&H0A 3572 DATA &H88,&H34 3573 DATA &H8B,&H76,&H08 3574 DATA &H88,&H14 3575 DATA &H8B,&H76,&H06 3576 DATA &H31,&HD2 3577 DATA &H89,&H14 3578 DATA &H5D 3579 DATA &HCA,&H0A,&H00 3580 END 3581 RESTORE 3582 FILENAME$="A:"+"GETDATE.EMU" 3583 PGM.LEN=42 3584 OPEN FILENAME$ AS #1 LEN=1 3585 FIELD #1, 1 AS PGM.BYTE$ 3586 FOR I=0 TO PGM.LEN 3587 READ J 3588 LSET PGM.BYTE$=CHR$(J) 3589 PUT #1 3590 NEXT 3591 CLOSE 3592 RESTORE 3593 RETURN 4000 '********************************************************************** 4001 '* 4002 '* SUBROUTINE FUNCTION : GET DOS VERSION NUMBER 4003 '* 4004 '* VERSION : 1.0 4005 '* 4006 '* DATE LAST UPDATED : SEPT 25, 1983 4007 '* 4008 '* AUTHOR : JAMES P MORGAN 4009 '* 4010 '* CALL FORMAT : 4011 '* --------------------- 4012 '* CALL OFFSET%(MAJOR.VERSION%,MINOR.VERSION%,RETURN.CODE%) 4013 '* 4014 '* PARAMETERS PASSED : MAJOR.VERSION%=0 4015 '* MINOR.VERSION%=0 4016 '* RETURN.CODE%=0 4017 '* 4018 '* PARAMETERS RETURNED : MAJOR.VERSION% (MAJOR DOS VERSION NUMBER) 4019 '* MINOR.VERSION% (MINOR DOS VERSION NUMBER) 4020 '* RETURN.CODE% 4021 '* 4022 '* COMMENTS : 4023 '* IF THE MAJOR.VERSION% RETURNS ZERO(0), IT IS 4024 '* ASSUMED THAT THIS IS A PRE-DOS 2.0 SYSTEM. 4025 '* 4026 '************************************************************************** 4027 CLS 4028 CLOSE 4029 DEF SEG 4030 DEFINT A-Z 4031 DIM SUBRT%(40) 4032 OFFSET%=0 4033 MAJOR.VERSION%=0 4034 MINOR.VERSION%=0 4035 RETURN.CODE%=0 4036 GOSUB 4064 4037 GOSUB 4044 4038 OFFSET%=VARPTR(SUBRT%(0)) 4039 CALL OFFSET%(MAJOR.VERSION%,MINOR.VERSION%,RETURN.CODE%) 4040 PRINT "MAJOR.VERSION = ";MAJOR.VERSION% 4041 PRINT "MINOR VERSION = ";MINOR.VERSION% 4042 PRINT "RETURN CODE = ";RETURN.CODE% 4043 END 4044 RESTORE 4045 FOR I=0 TO 27 4046 READ J 4047 POKE (VARPTR(SUBRT%(0))+I),J 4048 NEXT 4049 RETURN 4050 DATA &H55 4051 DATA &H89,&HE5 4052 DATA &HB4,&H30 4053 DATA &HCD,&H21 4054 DATA &H8B,&H76,&H0A 4055 DATA &H88,&H04 4056 DATA &H8B,&H76,&H08 4057 DATA &H88,&H24 4058 DATA &H8B,&H76,&H06 4059 DATA &H31,&HDB 4060 DATA &H89,&H1C 4061 DATA &H5D 4062 DATA &HCA,&H06,&H00 4063 END 4064 RESTORE 4065 FILENAME$="A:"+"DOSVER.EMU" 4066 PGM.LEN=27 4067 OPEN FILENAME$ AS #1 LEN=1 4068 FIELD #1, 1 AS PGM.BYTE$ 4069 FOR I=0 TO PGM.LEN 4070 READ J 4071 LSET PGM.BYTE$=CHR$(J) 4072 PUT #1 4073 NEXT 4074 CLOSE 4075 RESTORE 4076 RETURN 4500 '********************************************************************** 4501 '* 4502 '* SUBROUTINE FUNCTION : GET DISK FREE SPACE 4503 '* 4504 '* VERSION : 1.0 4505 '* 4506 '* DATE LAST UPDATED : SEPT 25, 1983 4507 '* 4508 '* AUTHOR : JAMES P MORGAN 4509 '* 4510 '* CALL FORMAT : 4511 '* --------------------- 4512 '* CALL OFFSET%(DRIVE%,NUM.ALLOC.UNITS%,NUM.SEC.PER.UNIT%,SECTOR.SIZE%,AVAIL.CLUSTERS%,RETURN.CODE%) 4513 '* 4514 '* PARAMETERS PASSED : DRIVE% (0=DEFAULT,1=A,2=B..ECT) 4515 '* NUM.ALLOC.UNITS%=0 4516 '* NUM.SEC.PER.UNIT%=0 4517 '* SECTOR.SIZE%=0 4518 '* AVAIL.CLUSTERS%=0 4519 '* RETURN.CODE%=0 4520 '* 4521 '* PARAMETERS RETURNED : DRIVE% 4522 '* NUM.ALLOC.UNITS% (TOTAL CLUSTERS ON THE 4523 '* DRIVE) 4524 '* 4525 '* NUM.SEC.PER.UNIT% (NUMBER OF SECTORS PER 4526 '* CLUSTER) 4527 '* 4528 '* SECTOR.SIZE% (BYTES PER SECTOR) 4529 '* 4530 '* AVAIL.CLUSTERS% (NUMBER OF AVAILABLE CLUSTERS) 4531 '* 4532 '* RETURN.CODE% (255=INVALID DRIVE) 4533 '* 4534 '* 4535 '* COMMENTS : 4536 '* THIS DOS FUNCTION CALL RETURNS THE SANE INFO 4537 '* (EXCEPT FOR THE FAT POINTER) AS THE GET FAT POINTER 4538 '* CALL (1BH) DID UNDER PREVIOUS VERSIONS OF DOS. 4539 '************************************************************************** 4540 CLS 4541 CLOSE 4542 DEF SEG 4543 DEFINT A-Z 4544 DIM SUBRT%(40) 4545 OFFSET%=0 4546 DRIVE%=1 4547 NUM.ALLOC.UNITS%=0 4548 NUM.SEC.PER.UNIT%=0 4549 SECTOR.SIZE%=0 4550 AVAIL.CLUSTERS%=0 4551 RETURN.CODE%=0 4552 GOSUB 4596 4553 GOSUB 4564 4554 OFFSET%=VARPTR(SUBRT%(0)) 4555 CALL OFFSET%(DRIVE%,NUM.ALLOC.UNITS%,NUM.SEC.PER.UNIT%,SECTOR.SIZE%,AVAIL.CLUSTERS%,RETURN.CODE%) 4556 PRINT "DRIVE REQUESTED = ";DRIVE% 4557 PRINT "ALLOC CLUSTERS = ";NUM.ALLOC.UNITS% 4558 PRINT "SECTORS PER CLUSTE= ";NUM.SEC.PER.UNIT% 4559 PRINT "BYTES PER SECTOR = ";SECTOR.SIZE% 4560 PRINT "AVAIL. CLUSTERS = ";AVAIL.CLUSTERS% 4561 PRINT "FREE SPACE = ";SECTOR.SIZE%*NUM.SEC.PER.UNIT%*AVAIL.CLUSTERS% 4562 PRINT "RETURN CODE = ";RETURN.CODE% 4563 END 4564 RESTORE 4565 FOR I=0 TO 60 4566 READ J 4567 POKE (VARPTR(SUBRT%(0))+I),J 4568 NEXT 4569 RETURN 4570 DATA &H55 4571 DATA &H89,&HE5 4572 DATA &H31,&HC0 4573 DATA &H31,&HDB 4574 DATA &H31,&HC9 4575 DATA &H31,&HD2 4576 DATA &H8B,&H76,&H10 4577 DATA &H8A,&H14 4578 DATA &HB4,&H36 4579 DATA &HCD,&H21 4580 DATA &H8B,&H76,&H0E 4581 DATA &H88,&H14 4582 DATA &H88,&H74,&H01 4583 DATA &H8B,&H76,&H0C 4584 DATA &H88,&H04 4585 DATA &H88,&H64,&H01 4586 DATA &H8B,&H76,&H0A 4587 DATA &H88,&H0C 4588 DATA &H88,&H6C,&H01 4589 DATA &H8B,&H76,&H08 4590 DATA &H88,&H1C 4591 DATA &H88,&H7C,&H01 4592 DATA &H8B,&H76,&H06 4593 DATA &H89,&H04 4594 DATA &H5D 4595 DATA &HCA,&H0C,&H00 4596 RESTORE 4597 FILENAME$="A:"+"FREESPAC.EMU" 4598 PGM.LEN=60 4599 OPEN FILENAME$ AS #1 LEN=1 4600 FIELD #1, 1 AS PGM.BYTE$ 4601 FOR I=0 TO PGM.LEN 4602 READ J 4603 LSET PGM.BYTE$=CHR$(J) 4604 PUT #1 4605 NEXT 4606 CLOSE 4607 RESTORE 4608 RETURN 5000 '********************************************************************** 5001 '* 5002 '* SUBROUTINE FUNCTION : CHANGE/CREATE/REMOVE A DIRECTORY 5003 '* 5004 '* VERSION : 1.0 5005 '* 5006 '* DATE LAST UPDATED : SEPT 25, 1983 5007 '* 5008 '* AUTHOR : JAMES P MORGAN 5009 '* 5010 '* CALL FORMAT : 5011 '* --------------------- 5012 '* CALL OFFSET%(FUNCTION.CALL%,ASCIIZ.STRING$,RETURN.CODE%) 5013 '* 5014 '* PARAMETERS PASSED : FUNCTION.CALL% (&H39 - MKDIR 5015 '* &H3A - RMDIR 5016 '* &H3B - CHDIR) 5017 '* 5018 '* ASCIIZ.STRING$ (THE ASCII STRING OF THE 5019 '* DIRECTORY TO BE USED) 5020 '* 5021 '* RETURN.CODE%=0 5022 '* 5023 '* PARAMETERS RETURNED : FUNCTION.CALL% 5024 '* ASCIIZ.STRING$ 5025 '* RETURN.CODE% (SEE ERROR CODE LIST) 5026 '* 5027 '* 5028 '* COMMENTS : 5029 '* 5030 '* EACH OF THE DIRECTORY MAINTENANCE FUNCTIONS ARE DISCUSSED SEPARATELY 5031 '* 5032 '* MKDIR ------------- CREATE A DIRECTORY 5033 '* 5034 '* THE ASCIIZ STRING CONTAINS THE DRIVE AND DIRECTORY 5035 '* PATH NAMES. IF ANY MEMBER OF THE DIRECTORY PATH DOES NOT 5036 '* EXIST THEN THE DIRECTORY PATH IS NOT CHANGED. ON RETURN 5037 '* A NEW DIRECTORY IS CREATED AT THE END OF THE SPECIFIED 5038 '* PATH. 5039 '* 5040 '* RMDIR ------------- REMOVE A SUB-DIRECTORY 5041 '* 5042 '* THE ASCIIZ STRING CONTAINS THE DRIVE AND DIRECTORY 5043 '* PATH NAMES. THE SPECIFIED DIRECTORY IS REMOVED FROM THE 5044 '* STRUCTURE. THE CURRENT DIRECTORY CANNOT BE REMOVED. 5045 '* 5046 '* CHDIR ------------- CHANGE THE CURRENT DIRECTORY 5047 '* 5048 '* THE ASCIIZ STRING CONTAINS THE DRIVE AND DIRECTORY 5049 '* PATH NAMES. IF ANY MEMBER OF THE DIRECTORY DOES NOT EXIST 5050 '* THEN THE DIRECTORY PATH IS NOT CHANGED. 5051 '* 5052 '************************************************************************* 5053 CLS 5054 CLOSE 5055 DEF SEG 5056 DEFINT A-Z 5057 DIM SUBRT%(40) 5058 OFFSET%=0 5059 FUNCTION.CALL%=&H3B 5060 FUNCTION.TYPE$="" 5061 PATH.NAME$="C:\EMULATOR" 5062 ASCIIZ.STRING$=PATH.NAME$+CHR$(0) 5063 RETURN.CODE%=0 5064 GOSUB 5099 5065 GOSUB 5076 5066 OFFSET%=VARPTR(SUBRT%(0)) 5067 CALL OFFSET%(FUNCTION.CALL%,ASCIIZ.STRING$,RETURN.CODE%) 5068 IF FUNCTION.CALL%=&H39 THEN FUNCTION.TYPE$="CREATE A SUB-DIRECTORY" 5069 IF FUNCTION.CALL%=&H3A THEN FUNCTION.TYPE$="REMOVE A DIRECTORY" 5070 IF FUNCTION.CALL%=&H3B THEN FUNCTION.TYPE$="CHANGE THE CURRENT DIRECTORY" 5071 PRINT "FUNCTION CALL CODE= ";FUNCTION.CALL% 5072 PRINT "FUNCTION TYPE = ";FUNCTION.TYPE$ 5073 PRINT "PATH IS = ";PATH.NAME$ 5074 PRINT "RETURN CODE = ";RETURN.CODE% 5075 END 5076 RESTORE 5077 FOR I=0 TO 30 5078 READ J 5079 POKE (VARPTR(SUBRT%(0))+I),J 5080 NEXT 5081 RETURN 5082 DATA &H55 5083 DATA &H89,&HE5 5084 DATA &H31,&HC0 5085 DATA &H8B,&H76,&H0A 5086 DATA &H8A,&H24 5087 DATA &H8B,&H76,&H08 5088 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER 5089 DATA &H8B,&H54,&H01 5090 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER 5091 'DATA &H8B,&H54,&H02 5092 DATA &HCD,&H21 5093 DATA &H72,&H02 5094 DATA &H30,&HC0 5095 DATA &H8B,&H76,&H06 5096 DATA &H88,&H04 5097 DATA &H5D 5098 DATA &HCA,&H06,&H00 5099 RESTORE 5100 FILENAME$="A:"+"DIRMAINT.EMU" 5101 PGM.LEN=30 5102 OPEN FILENAME$ AS #1 LEN=1 5103 FIELD #1, 1 AS PGM.BYTE$ 5104 FOR I=0 TO PGM.LEN 5105 READ J 5106 LSET PGM.BYTE$=CHR$(J) 5107 PUT #1 5108 NEXT 5109 CLOSE 5110 RESTORE 5111 RETURN 5500 '********************************************************************** 5501 '* 5502 '* SUBROUTINE FUNCTION : GET/SET CURRENT DEFAULT DISK DRIVE 5503 '* 5504 '* VERSION : 1.0 5505 '* 5506 '* DATE LAST UPDATED : SEPT 25, 1983 5507 '* 5508 '* AUTHOR : JAMES P MORGAN 5509 '* 5510 '* CALL FORMAT : 5511 '* --------------------- 5512 '* CALL OFFSET%(DRIVE%,LOGICAL.DRIVES%,RETURN.CODE%) 5513 '* 5514 '* PARAMETERS PASSED : DRIVE% (0=A,2=B..ECT) 5515 '* LOGICAL.DRIVES%=0 5516 '* RETURN.CODE%=0 5517 '* 5518 '* PARAMETERS RETURNED : DRIVE% 5519 '* LOGICAL.DRIVES% (0-MAX LOGICAL DRIVES) 5520 '* RETURN.CODE% (CURRENT DEFAULT DRIVE) 5521 '* 5522 '* 5523 '* COMMENTS : 5524 '* THIS SUBROUTINE WILL ASSIGN, DRIVE%, AS THE 5525 '* DEFAULT DRIVE (IF VALID). THE NUMBER OF LOGICAL 5526 '* DRIVES (TOTAL DISKETTE AND FIXED) ARE RETURNED. 5527 '* IF THE SYSTEM HAS ONLY ONE DISKETTE DRIVE, IT WILL 5528 '* BE COUNTED AS TWO TO BE CONSISTANT WITH THE 5529 '* PHILOSOPHY OF THINKING OF THE SYSTEM AS HAVING 5530 '* LOGICAL DRIVES "A" AND "B". 5531 '* AS A SIDE EFFECT, IF YOU GIVE THIS SUBROUTINE 5532 '* AN INVALID DRIVE (255), IT WILL ONLY RETURN THE 5533 '* CURRENT DEFAULT DRIVE SO YOU DO NOT NEED TO DO 5534 '* A DOS FUNCTION CALL &H19, CURRENT DISK. 5535 '* 5536 '* BIOS EQUIPMENT CHECK DETERMINATION (INT 11H) 5537 '* CAN BE USED TO DETERMINE THE NUMBER OF ACTUAL 5538 '* PHYSICAL DRIVES. 5539 '* 5540 '************************************************************************* 5541 CLS 5542 CLOSE 5543 DEF SEG 5544 DEFINT A-Z 5545 DIM SUBRT%(40) 5546 OFFSET%=0 5547 DRIVE%=0 5548 LOGICAL.DRIVES%=0 5549 RETURN.CODE%=0 5550 GOSUB 5578 5551 GOSUB 5558 5552 OFFSET%=VARPTR(SUBRT%(0)) 5553 CALL OFFSET%(DRIVE%,LOGICAL.DRIVES%,RETURN.CODE%) 5554 PRINT "DEFAULT REQUESTED = ";DRIVE% 5555 PRINT "LOGICAL DRIVES = ";LOGICAL.DRIVES% 5556 PRINT "NEW DEFAULT DRIVE = ";RETURN.CODE% 5557 END 5558 RESTORE 5559 FOR I=0 TO 29 5560 READ J 5561 POKE (VARPTR(SUBRT%(0))+I),J 5562 NEXT 5563 RETURN 5564 DATA &H55 5565 DATA &H89,&HE5 5566 DATA &H8B,&H76,&H0A 5567 DATA &H8A,&H14 5568 DATA &HB4,&H0E 5569 DATA &HCD,&H21 5570 DATA &H8B,&H76,&H08 5571 DATA &H88,&H04 5572 DATA &HB4,&H19 5573 DATA &HCD,&H21 5574 DATA &H8B,&H76,&H06 5575 DATA &H88,&H04 5576 DATA &H5D 5577 DATA &HCA,&H06,&H00 5578 RESTORE 5579 FILENAME$="A:"+"DRIVEDEF.EMU" 5580 PGM.LEN=29 5581 OPEN FILENAME$ AS #1 LEN=1 5582 FIELD #1, 1 AS PGM.BYTE$ 5583 FOR I=0 TO PGM.LEN 5584 READ J 5585 LSET PGM.BYTE$=CHR$(J) 5586 PUT #1 5587 NEXT 5588 CLOSE 5589 RESTORE 5590 RETURN 6000 '********************************************************************** 6001 '* 6002 '* SUBROUTINE FUNCTION : GET CURRENT DIRECTORY 6003 '* 6004 '* VERSION : 1.0 6005 '* 6006 '* DATE LAST UPDATED : SEPT 25, 1983 6007 '* 6008 '* AUTHOR : JAMES P MORGAN 6009 '* 6010 '* CALL FORMAT : 6011 '* --------------------- 6012 '* CALL OFFSET%(DRIVE%,ASCIIZ.STRING$,RETURN.CODE%) 6013 '* 6014 '* PARAMETERS PASSED : DRIVE% (0=DEFAULT,1=A,2=B..ECT) 6015 '* ASCIIZ.STRING$ (AT LEAST A 64 BYTE 6016 '* CHARACTER STRING RETURN 6017 '* AREA) 6018 '* 6019 '* RETURN.CODE%=0 6020 '* 6021 '* PARAMETERS RETURNED : DRIVE% 6022 '* ASCIIZ.STRING$ (CURRENT DIRECTORY) 6023 '* RETURN.CODE% (SEE ERROR CODE LIST) 6024 '* 6025 '* 6026 '* COMMENTS : 6027 '* THIS SUBROUTINE WILL RETURN THE CURRENT DIRECTORY 6028 '* FOR THE SPECIFIED DRIVE. THE FULL PATH NAME , 6029 '* STARTING WITH THE ROOT DIRECTORY IS RETURNED. 6030 '* THE DRIVE LETTER WILL NOT BE PART OF THE RETURNED 6031 '* STRING. THE STRING WILL NOT BEGIN WITH THE "\" AND 6032 '* WILL BE TERMINATED WITH A BYTE CONTAINING A HEX 00. 6033 '* 6034 '************************************************************************* 6035 CLS 6036 CLOSE 6037 DEF SEG 6038 DEFINT A-Z 6039 DIM SUBRT%(40) 6040 OFFSET%=0 6041 DRIVE%=0 6042 ASCIIZ.STRING$=STRING$(80,0) 6043 CURRENT.DIRECTORY$="" 6044 RETURN.CODE%=0 6045 GOSUB 6079 6046 GOSUB 6057 6047 OFFSET%=VARPTR(SUBRT%(0)) 6048 CALL OFFSET%(DRIVE%,ASCIIZ.STRING$,RETURN.CODE%) 6049 IF RETURN.CODE%<>0 THEN CURRENT.DIRECTORY$="INVALID DRIVE SPECIFIED":GOTO 6053 6050 INSTR.LOC=INSTR(ASCIIZ.STRING$,CHR$(0)) 6051 IF INSTR.LOC<2 THEN CURRENT.DIRECTORY$="\":GOTO 6053 6052 CURRENT.DIRECTORY$="\"+LEFT$(ASCIIZ.STRING$,INSTR.LOC-1) 6053 PRINT "DRIVE REQUESTED = ";DRIVE% 6054 PRINT "CURRENT DIRECTORY = ";CURRENT.DIRECTORY$ 6055 PRINT "RETURN CODE = ";RETURN.CODE% 6056 END 6057 RESTORE 6058 FOR I=0 TO 28 6059 READ J 6060 POKE (VARPTR(SUBRT%(0))+I),J 6061 NEXT 6062 RETURN 6063 DATA &H55 6064 DATA &H89,&HE5 6065 DATA &H8B,&H76,&H0A 6066 DATA &H8A,&H14 6067 DATA &H8B,&H5E,&H08 6068 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER 6069 DATA &H8B,&H77,&H01 6070 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER 6071 'DATA &H8B,&H77,&H02 6072 DATA &H31,&HC0 6073 DATA &HB4,&H47 6074 DATA &HCD,&H21 6075 DATA &H8B,&H76,&H06 6076 DATA &H88,&H04 6077 DATA &H5D 6078 DATA &HCA,&H06,&H00 6079 RESTORE 6080 FILENAME$="A:"+"DIRCURR.EMU" 6081 PGM.LEN=28 6082 OPEN FILENAME$ AS #1 LEN=1 6083 FIELD #1, 1 AS PGM.BYTE$ 6084 FOR I=0 TO PGM.LEN 6085 READ J 6086 LSET PGM.BYTE$=CHR$(J) 6087 PUT #1 6088 NEXT 6089 CLOSE 6090 RESTORE 6091 RETURN 6500 '********************************************************************** 6501 '* 6502 '* SUBROUTINE FUNCTION : RENAME A FILE 6503 '* 6504 '* VERSION : 1.0 6505 '* 6506 '* DATE LAST UPDATED : SEPT 25, 1983 6507 '* 6508 '* AUTHOR : JAMES P MORGAN 6509 '* 6510 '* CALL FORMAT : 6511 '* --------------------- 6512 '* CALL OFFSET%(ASCIIZ.STRING1$,ASCIIZ.STRING2$,RETURN.CODE%) 6513 '* 6514 '* PARAMETERS PASSED : ASCIIZ.STRING1$ (THE ASCII STRING OF THE 6515 '* CURRENT FILE NAME) 6516 '* 6517 '* ASCIIZ.STRING2$ (THE ASCII STRING OF THE 6518 '* NEW FILE NAME) 6519 '* 6520 '* RETURN.CODE%=0 6521 '* 6522 '* PARAMETERS RETURNED : ASCIIZ.STRING1$ 6523 '* ASCIIZ.STRING2$ 6524 '* RETURN.CODE% (SEE ERROR CODE LIST) 6525 '* 6526 '* 6527 '* COMMENTS : 6528 '* THIS SUBROUTINE WILL RENAME A DIRECTORY ENTRY 6529 '* ASSOCIATED WITH A FILE NAME. 6530 '* THE ASCIIZ.STRING CONSISTS OF A DRIVE, PATH AND 6531 '* FILE NAME .GLOBAL FILE NAME CHARACTERS ARE NOT 6532 '* ALLOWED IN ANY PART OF THE STRING. 6533 '* IF A DRIVE IS SPECIFIED IN THE SECOND STRING, IT 6534 '* MUST BE THE SAME AS THE DRIVE SPECIFIED OR IMPLIED 6535 '* IN THE FIRST STRING. THE DIRECTORY PATHS NEED NOT BE 6536 '* THE SAME, ALLOWING A FILE TO BE MOVED TO ANOTHER 6537 '* DIRECTORY AND RENAMED IN THE PROCESS. 6538 '* 6539 '* 6540 '************************************************************************* 6541 CLS 6542 CLOSE 6543 DEF SEG 6544 DEFINT A-Z 6545 DIM SUBRT%(40) 6546 OFFSET%=0 6547 ASCIIZ.STRING2$="A:\CNTLBRK.EMU"+CHR$(0) 6548 ASCIIZ.STRING1$="A:\CNTLBRAK.EMU"+CHR$(0) 6549 RETURN.CODE%=0 6550 GOSUB 6587 6551 GOSUB 6558 6552 OFFSET%=VARPTR(SUBRT%(0)) 6553 CALL OFFSET%(ASCIIZ.STRING1$,ASCIIZ.STRING2$,RETURN.CODE%) 6554 PRINT "OLD FILE NAME = ";LEFT$(ASCIIZ.STRING1$,LEN(ASCIIZ.STRING1$)-1) 6555 PRINT "NEW FILE NAME = ";LEFT$(ASCIIZ.STRING2$,LEN(ASCIIZ.STRING2$)-1) 6556 PRINT "RETURN CODE = ";RETURN.CODE% 6557 END 6558 RESTORE 6559 FOR I=0 TO 37 6560 READ J 6561 POKE (VARPTR(SUBRT%(0))+I),J 6562 NEXT 6563 RETURN 6564 DATA &H55 6565 DATA &H89,&HE5 6566 DATA &H31,&HC0 6567 DATA &H31,&HD2 6568 DATA &H31,&HFF 6569 DATA &H8B,&H76,&H0A 6570 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER 6571 DATA &H8B,&H54,&H01 6572 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER 6573 'DATA &H8B,&H54,&H02 6574 DATA &H8B,&H76,&H08 6575 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER 6576 DATA &H8B,&H7C,&H01 6577 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER 6578 'DATA &H8B,&H7C,&H02 6579 DATA &HB4,&H56 6580 DATA &HCD,&H21 6581 DATA &H72,&H02 6582 DATA &H30,&HC0 6583 DATA &H8B,&H76,&H06 6584 DATA &H88,&H04 6585 DATA &H5D 6586 DATA &HCA,&H06,&H00 6587 RESTORE 6588 FILENAME$="A:"+"RENFILE.EMU" 6589 PGM.LEN=37 6590 OPEN FILENAME$ AS #1 LEN=1 6591 FIELD #1, 1 AS PGM.BYTE$ 6592 FOR I=0 TO PGM.LEN 6593 READ J 6594 LSET PGM.BYTE$=CHR$(J) 6595 PUT #1 6596 NEXT 6597 CLOSE 6598 RESTORE 6599 RETURN 7000 '********************************************************************** 7001 '* 7002 '* SUBROUTINE FUNCTION : DELETE A FILE FROM A SPECIFIC DIRECTORY (UNLINK) 7003 '* 7004 '* VERSION : 1.0 7005 '* 7006 '* DATE LAST UPDATED : SEPT 25, 1983 7007 '* 7008 '* AUTHOR : JAMES P MORGAN 7009 '* 7010 '* CALL FORMAT : 7011 '* --------------------- 7012 '* CALL OFFSET%(ASCIIZ.STRING$,RETURN.CODE%) 7013 '* 7014 '* PARAMETERS PASSED : ASCIIZ.STRING$ (THE ASCII STRING OF THE 7015 '* FILE TO BE DELETED) 7016 '* 7017 '* RETURN.CODE%=0 7018 '* 7019 '* PARAMETERS RETURNED : ASCIIZ.STRING$ 7020 '* RETURN.CODE% (SEE ERROR CODE LIST) 7021 '* 7022 '* 7023 '* COMMENTS : 7024 '* THIS SUBROUTINE WILL REMOVE A DIRECTORY ENTRY 7025 '* ASSOCIATED WITH A FILE NAME. 7026 '* THE ASCIIZ.STRING CONSISTS OF A DRIVE, PATH AND 7027 '* FILE NAME .GLOBAL FILE NAME CHARACTERS ARE NOT 7028 '* ALLOWED IN ANY PART OF THE STRING. 7029 '* READ-ONLY FILES CANNOT BE DELETED WITH THIS CALL. 7030 '* TO DELETE ONE OF THESE FILES, FIRST USE AN INT 43H 7031 '* CALL (OR THE CHANGE MODE SUBROUTINE INCLUDED WITH 7032 '* THIS SERIES OF SUBROUTINES) TO CHANGE THE FILES 7033 '* ATTRIBUTE TO ZERO(0) , THEN DELETE THE FILE. 7034 '************************************************************************* 7035 CLS 7036 CLOSE 7037 DEF SEG 7038 DEFINT A-Z 7039 DIM SUBRT%(40) 7040 OFFSET%=0 7041 ASCIIZ.STRING$="C:\CNTLBRK.EMU"+CHR$(0) 7042 RETURN.CODE%=0 7043 GOSUB 7073 7044 GOSUB 7050 7045 OFFSET%=VARPTR(SUBRT%(0)) 7046 CALL OFFSET%(ASCIIZ.STRING$,RETURN.CODE%) 7047 PRINT "DELETED FILE NAME = ";LEFT$(ASCIIZ.STRING$,LEN(ASCIIZ.STRING$)-1) 7048 PRINT "RETURN CODE = ";RETURN.CODE% 7049 END 7050 RESTORE 7051 FOR I=0 TO 29 7052 READ J 7053 POKE (VARPTR(SUBRT%(0))+I),J 7054 NEXT 7055 RETURN 7056 DATA &H55 7057 DATA &H89,&HE5 7058 DATA &H31,&HC0 7059 DATA &H31,&HD2 7060 DATA &H8B,&H76,&H08 7061 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER 7062 DATA &H8B,&H54,&H01 7063 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER 7064 'DATA &H8B,&H54,&H02 7065 DATA &HB4,&H41 7066 DATA &HCD,&H21 7067 DATA &H72,&H02 7068 DATA &H30,&HC0 7069 DATA &H8B,&H76,&H06 7070 DATA &H88,&H04 7071 DATA &H5D 7072 DATA &HCA,&H04,&H00 7073 RESTORE 7074 FILENAME$="A:"+"DELFILE.EMU" 7075 PGM.LEN=29 7076 OPEN FILENAME$ AS #1 LEN=1 7077 FIELD #1, 1 AS PGM.BYTE$ 7078 FOR I=0 TO PGM.LEN 7079 READ J 7080 LSET PGM.BYTE$=CHR$(J) 7081 PUT #1 7082 NEXT 7083 CLOSE 7084 RESTORE 7085 RETURN 7500 '********************************************************************** 7501 '* 7502 '* SUBROUTINE FUNCTION : CHANGE A FILE'S MODE (ATTRIBUTE) 7503 '* 7504 '* VERSION : 1.0 7505 '* 7506 '* DATE LAST UPDATED : SEPT 25, 1983 7507 '* 7508 '* AUTHOR : JAMES P MORGAN 7509 '* 7510 '* CALL FORMAT : 7511 '* --------------------- 7512 '* CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,RETURN.CODE%) 7513 '* 7514 '* PARAMETERS PASSED : FUNCTION.CODE% (00=RETURN ATTRIBUTE 7515 '* 01=CHANGE ATTRIBUTE 7517 '* 7518 '* ATTRIBUTE% (FILE ATTRIBUTE) 7519 '* 7520 '* ASCIIZ.STRING$ (THE ASCII STRING OF THE 7521 '* FILE) 7522 '* 7523 '* RETURN.CODE%=0 7524 '* 7525 '* PARAMETERS RETURNED : FUNCTION.CODE% 7526 '* ATTRIBUTE% (FILE ATTRIBUTE) 7527 '* ASCIIZ.STRING$ 7528 '* RETURN.CODE% (SEE ERROR CODE LIST) 7529 '* 7530 '* 7531 '* COMMENTS : 7532 '* IF THE FUNCTION.CODE% IS SET TO 00 THEN THE FILES 7533 '* CURRENT ATTRIBUTE WILL BE RETURNED, ELSE IF THE 7534 '* FUNCTION.CODE% IS SET TO 01, THE FILE'S ATTRIBUTE 7535 '* WILL BE CHANGED TO THE ATTRIBUTE% PASSED TO THE 7536 '* SUBROUTINE. 7537 '* THE ASCIIZ STRING CONSISTS OF THE DRIVE, PATH, AND 7538 '* FILENAME. 7539 '* SEEMS THAT THIS DOS FUNCTION CALL WILL NOT LET YOU 7540 '* CHANGE A FILES MODE TO THAT OF A VOLUME LABEL (&H8). 7541 '* 7542 '* 7543 '************************************************************************* 7544 '* 7545 '*************** FILE ATTRIBUTE BYTES - VALUES IN HEXADECIMAL *********** 7546 '* 7547 '* 01H - FILE IS READ ONLY (CAN BE USED WITH OTHERS) 7548 '* 02H - HIDDEN FILE 7549 '* 04H - SYSTEM FILE 7550 '* 08H - VOLUME LABEL (ONLY FIRST 11 CHARACTERS) 7551 '* 10H - SUB-DIRECTORY ENTRY 7552 '* 20H - ARCHIVE BIT (CAN BE USED WITH OTHERS 7553 '* SET WHEN FILE WRITTEN TO AND CLOSED) 7554 CLS 7555 CLOSE 7556 DEF SEG 7557 DEFINT A-Z 7558 DIM SUBRT%(40) 7559 OFFSET%=0 7560 FUNCTION.CODE%=1 7561 ATTRIBUTE%=0 7562 ATTRIBUTE.SENT%=ATTRIBUTE% 7563 PATH.NAME$="C:DOSVER.EMU" 7564 ASCIIZ.STRING$=PATH.NAME$+CHR$(0) 7565 RETURN.CODE%=0 7566 GOSUB 7606 7567 GOSUB 7576 7568 OFFSET%=VARPTR(SUBRT%(0)) 7569 CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,RETURN.CODE%) 7570 PRINT "FUNCTION REQUESTED= ";FUNCTION.CODE% 7571 PRINT "FILE PATH = ";PATH.NAME$ 7572 PRINT "ATTRIBUTE SENT = ";ATTRIBUTE.SENT% 7573 PRINT "ATTRIBUTE RETURNED= ";ATTRIBUTE% 7574 PRINT "RETURN CODE = ";RETURN.CODE% 7575 END 7576 RESTORE 7577 FOR I=0 TO 46 7578 READ J 7579 POKE (VARPTR(SUBRT%(0))+I),J 7580 NEXT 7581 RETURN 7582 DATA &H55 7583 DATA &H89,&HE5 7584 DATA &H31,&HC0 7585 DATA &H31,&HC9 7586 DATA &H31,&HD2 7587 DATA &H8B,&H76,&H0C 7588 DATA &H8A,&H04 7589 DATA &H8B,&H76,&H08 7590 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER 7591 DATA &H8B,&H54,&H01 7592 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER 7593 'DATA &H8B,&H54,&H02 7594 DATA &H8B,&H76,&H0A 7595 DATA &H8B,&H0C 7596 DATA &HB4,&H43 7597 DATA &HCD,&H21 7598 DATA &H72,&H02 7599 DATA &H30,&HC0 7600 DATA &H8B,&H76,&H06 7601 DATA &H88,&H04 7602 DATA &H8B,&H76,&H0A 7603 DATA &H89,&H0C 7604 DATA &H5D 7605 DATA &HCA,&H08,&H00 7606 RESTORE 7607 FILENAME$="A:"+"CHNGMODE.EMU" 7608 PGM.LEN=46 7609 OPEN FILENAME$ AS #1 LEN=1 7610 FIELD #1, 1 AS PGM.BYTE$ 7611 FOR I=0 TO PGM.LEN 7612 READ J 7613 LSET PGM.BYTE$=CHR$(J) 7614 PUT #1 7615 NEXT 7616 CLOSE 7617 RESTORE 7618 RETURN